home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / MacGambit 2.0 / sources2 / Interp⁄Comp (.scm) / target-m68000-2.scm < prev    next >
Encoding:
Text File  |  1992-06-04  |  61.2 KB  |  117 lines  |  [TEXT/gamI]
  2. (define (emit-asr.l opnd1 opnd2)
  3.   (if (dreg? opnd1)
  4.     (asm-word (+ #xe0a0 (+ (* (dreg-num opnd1) 512) (dreg-num opnd2))))
  5.     (let ((n (imm-val opnd1)))
  6.       (asm-word (+ #xe080 (+ (* (if (= n 8) 0 n) 512) (dreg-num opnd2))))))
  7.   (if ofile-asm?
  8.     (emit-asm "asrl" ofile-tab (opnd-str opnd1) "," (opnd-str opnd2))))
  9.  
  10. (define (emit-asr.w opnd1 opnd2)
  11.   (if (dreg? opnd1)
  12.     (asm-word (+ #xe060 (+ (* (dreg-num opnd1) 512) (dreg-num opnd2))))
  13.     (let ((n (imm-val opnd1)))
  14.       (asm-word (+ #xe040 (+ (* (if (= n 8) 0 n) 512) (dreg-num opnd2))))))
  15.   (if ofile-asm?
  16.     (emit-asm "asrw" ofile-tab (opnd-str opnd1) "," (opnd-str opnd2))))
  17.  
  18. (define (emit-lsl.l opnd1 opnd2)
  19.   (if (dreg? opnd1)
  20.     (asm-word (+ #xe1a8 (+ (* (dreg-num opnd1) 512) (dreg-num opnd2))))
  21.     (let ((n (imm-val opnd1)))
  22.       (asm-word (+ #xe188 (+ (* (if (= n 8) 0 n) 512) (dreg-num opnd2))))))
  23.   (if ofile-asm?
  24.     (emit-asm "lsll" ofile-tab (opnd-str opnd1) "," (opnd-str opnd2))))
  25.  
  26. (define (emit-lsr.l opnd1 opnd2)
  27.   (if (dreg? opnd1)
  28.     (asm-word (+ #xe0a8 (+ (* (dreg-num opnd1) 512) (dreg-num opnd2))))
  29.     (let ((n (imm-val opnd1)))
  30.       (asm-word (+ #xe088 (+ (* (if (= n 8) 0 n) 512) (dreg-num opnd2))))))
  31.   (if ofile-asm?
  32.     (emit-asm "lsrl" ofile-tab (opnd-str opnd1) "," (opnd-str opnd2))))
  33.  
  34. (define (emit-lsr.w opnd1 opnd2)
  35.   (if (dreg? opnd1)
  36.     (asm-word (+ #xe068 (+ (* (dreg-num opnd1) 512) (dreg-num opnd2))))
  37.     (let ((n (imm-val opnd1)))
  38.       (asm-word (+ #xe048 (+ (* (if (= n 8) 0 n) 512) (dreg-num opnd2))))))
  39.   (if ofile-asm?
  40.     (emit-asm "lsrw" ofile-tab (opnd-str opnd1) "," (opnd-str opnd2))))
  41.  
  42. (define (emit-clr.l opnd)
  43.   (asm-word (+ #x4280 (opnd->mode/reg opnd)))
  44.   (opnd-ext-wr-long opnd)
  45.   (if ofile-asm?
  46.     (emit-asm "clrl" ofile-tab (opnd-str opnd))))
  47.  
  48. (define (emit-neg.l opnd)
  49.   (asm-word (+ #x4480 (opnd->mode/reg opnd)))
  50.   (opnd-ext-wr-long opnd)
  51.   (if ofile-asm?
  52.     (emit-asm "negl" ofile-tab (opnd-str opnd))))
  53.  
  54. (define (emit-not.l opnd)
  55.   (asm-word (+ #x4680 (opnd->mode/reg opnd)))
  56.   (opnd-ext-wr-long opnd)
  57.   (if ofile-asm?
  58.     (emit-asm "notl" ofile-tab (opnd-str opnd))))
  59.  
  60. (define (emit-ext.l opnd)
  61.   (asm-word (+ #x48c0 (dreg-num opnd)))
  62.   (if ofile-asm?
  63.     (emit-asm "extl" ofile-tab (opnd-str opnd))))
  64.  
  65. (define (emit-ext.w opnd)
  66.   (asm-word (+ #x4880 (dreg-num opnd)))
  67.   (if ofile-asm?
  68.     (emit-asm "extw" ofile-tab (opnd-str opnd))))
  69.  
  70. (define (emit-swap opnd)
  71.   (asm-word (+ #x4840 (dreg-num opnd)))
  72.   (if ofile-asm?
  73.     (emit-asm "swap" ofile-tab (opnd-str opnd))))
  74.  
  75. (define (emit-cmp.l opnd1 opnd2)
  76.   (cond ((areg? opnd2)
  77.          (asm-word (+ #xb1c0 (+ (* (areg-num opnd2) 512) (opnd->mode/reg opnd1))))
  78.          (opnd-ext-rd-long opnd1))
  79.         ((imm? opnd1)
  80.          (asm-word (+ #x0c80 (opnd->mode/reg opnd2)))
  81.          (opnd-ext-rd-long opnd1)
  82.          (opnd-ext-rd-long opnd2))
  83.         (else
  84.          (asm-word (+ #xb080 (+ (* (dreg-num opnd2) 512) (opnd->mode/reg opnd1))))
  85.          (opnd-ext-rd-long opnd1)))
  86.   (if ofile-asm?
  87.     (emit-asm "cmpl" ofile-tab (opnd-str opnd1) "," (opnd-str opnd2))))
  88.  
  89. (define (emit-cmp.w opnd1 opnd2)
  90.   (cond ((areg? opnd2)
  91.          (asm-word (+ #xb0c0 (+ (* (areg-num opnd2) 512) (opnd->mode/reg opnd1))))
  92.          (opnd-ext-rd-word opnd1))
  93.         ((imm? opnd1)
  94.          (asm-word (+ #x0c40 (opnd->mode/reg opnd2)))
  95.          (opnd-ext-rd-word opnd1)
  96.          (opnd-ext-rd-word opnd2))
  97.         (else
  98.          (asm-word (+ #xb040 (+ (* (dreg-num opnd2) 512) (opnd->mode/reg opnd1))))
  99.          (opnd-ext-rd-word opnd1)))
  100.   (if ofile-asm?
  101.     (emit-asm "cmpw" ofile-tab (opnd-str opnd1) "," (opnd-str opnd2))))
  102.  
  103. (define (emit-cmp.b opnd1 opnd2)
  104.   (cond ((imm? opnd1)
  105.          (asm-word (+ #x0c00 (opnd->mode/reg opnd2)))
  106.          (opnd-ext-rd-word opnd1)
  107.          (opnd-ext-rd-word opnd2))
  108.         (else
  109.          (asm-word (+ #xb000 (+ (* (dreg-num opnd2) 512) (opnd->mode/reg opnd1))))
  110.          (opnd-ext-rd-word opnd1)))
  111.   (if ofile-asm?
  112.     (emit-asm "cmpb" ofile-tab (opnd-str opnd1) "," (opnd-str opnd2))))
  113.  
  114. (define (emit-tst.l opnd)
  115.   (asm-word (+ #x4a80 (opnd->mode/reg opnd)))
  116.   (opnd-ext-rd-long opnd)
  117.   (